perm filename SCARLE.F4[SAB,LCS]1 blob sn#349445 filedate 1978-04-15 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		REAL NA
C00003 ENDMK
CāŠ—;
	REAL NA
	DIMENSION IBUF(5000)
	COMMON /FAC/JFAC,KFAC
	TYPE 1
	ACCEPT 2,JFAC,KFAC
1	FORMAT(' TYPE X FACTOR AND Y FACTOR   '$)
2	FORMAT(2I)
	CALL PLOTS(IBUF,5000,1)
	CALL PLOT(15.,14.75,-3)
	
	IF(JFAC.EQ.0)JFAC=100
	IF(KFAC.EQ.0)KFAC=100
      	A=5.
	B=5.  
	ANGLE=0.
10	CALL ELLIPS(A,B,ANGLE)
20	DO 50 M=1,40
	NA=A
 	NA=(1.-.025*M)*NA
	ANGLE=ANGLE+2.25
30	CALL ELLIPS(NA,B,ANGLE)
50	CONTINUE
	ANGLE=0.
	DO 60 N=1,40
	NA=A
	NA=(1.-.025*N)*NA
	ANGLE=ANGLE-2.25
	CALL ELLIPS(NA,B,ANGLE)
60	CONTINUE
	A=A-1.
	CALL PLOT(0.,-30.,-3)
	CALL PLOT(0.,0.,999)
	STOP     
	END